home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_nn-tk.idb / usr / freeware / lib / nn / tcl / windows.tcl.z / windows.tcl
Encoding:
Text File  |  1999-04-16  |  33.2 KB  |  1,394 lines
  1. #
  2. #  Popup showing nntp transfer  progress
  3. #
  4. proc nntp_lmsg {cnt aflg} {
  5.     global Config
  6.  
  7.     mprompt_msg $cnt
  8.     update
  9. }
  10.  
  11. proc nntp_kmsg {} {
  12.     global Config
  13.  
  14.     mprompt_clear
  15. }
  16.     
  17. #
  18. #  Posting PoPup
  19. #
  20. # Pass values in global variables because they may have arbitrary
  21. # characters in them
  22. #
  23. proc post_Make {already increment imessage args} {
  24.     global Config has_exmh
  25.     toplevel .post
  26.     frame .post.s
  27.     pack .post.s
  28.  
  29.     set n 0
  30.     foreach x $args {
  31.     global post_$x
  32.     frame .post.s.f$n
  33.     label .post.s.f$n.l -text $x
  34.     pack .post.s.f$n.l -side left -expand yes -fill x
  35.     entry .post.s.f$n.e  -width 60
  36.     .post.s.f$n.e delete 0 999
  37.     .post.s.f$n.e insert 0 [set post_$x]
  38.     pack   .post.s.f$n.e -side right
  39.     pack .post.s.f$n -fill x
  40.     incr n
  41.     }
  42.  
  43.     if {$increment == "1"} {
  44.     frame .post.i -borderwidth 2  -relief ridge
  45.     checkbutton .post.i.b -variable post_include -text $imessage -relief flat
  46.     global post_include
  47.     set post_include 1
  48.     pack .post.i.b
  49.     pack .post.i -expand yes -fill x
  50.     }
  51.  
  52.     frame .post.x -relief sunken -borderwidth 2
  53.     if {$already != -1} {
  54.     if {$already == 1} {
  55.         set xedit x
  56.     } else {
  57.         set xedit s
  58.     }
  59.     button .post.x.go -text "  Do  " -command "post_do $xedit $n"
  60.     button .post.x.exit  -text "Cancel" -command "post_exit"
  61.     pack .post.x.go  .post.x.exit -side left -padx 25m -pady 5m
  62.     } else {
  63.     if {$has_exmh} {
  64.         button .post.x.edit -text "internal editor" -command "post_do  s $n"
  65.     } else {
  66.         button .post.x.edit -text "internal editor" -command "post_do  s $n" -state disabled
  67.     }
  68.     button .post.x.xt -text "external editor" -command "post_do x $n" 
  69.     button .post.x.exit  -text "Cancel" -command "post_exit"
  70.  
  71.     pack .post.x.edit .post.x.xt .post.x.exit -side left -padx 12m -pady 5m
  72.     }
  73.     pack .post.x -side top -fill both -expand yes
  74.  
  75.     if {[info exists Config(.post)]} {
  76.     wm geometry  .post $Config(.post)
  77.     }
  78.     wm minsize .post 0 0
  79. }
  80.  
  81. proc post_do {c n} {
  82.  
  83.     if {$n > 0} {
  84.     for {set i 0} {$i < $n} {incr i} {
  85.         set var [lindex [.post.s.f$i.l configure -text] 4]
  86.         global post_$var
  87.         set post_$var  [.post.s.f$i.e get]
  88.     }
  89.     }
  90.  
  91.     if {![info exists post_Subject] || $post_Subject != ""} {
  92.     put_key $c
  93.     destroy .post
  94.     } else {
  95.     msg_tmp "You must enter a subject"
  96.     }
  97. }
  98.  
  99. proc post_exit {} {
  100.     put_key  e
  101.     destroy .post
  102. }
  103.  
  104. #
  105. # message - popup
  106. #
  107. proc msg_Make {mess warn} {
  108.     global Config
  109.  
  110.     if {$Config(compressed_prompt) != 0} {
  111.     mprompt_msg $mess
  112.     }
  113.  
  114.     if {($Config(compressed_prompt) != 2) || $warn} {
  115.     catch {destroy .msg}
  116.     toplevel .msg
  117.     wm transient .msg .
  118.     wm geometry .msg +300+300
  119.  
  120.     message .msg.m -text $mess -aspect 800
  121.  
  122.     pack .msg.m -side left -expand yes -fill both
  123.     }    
  124. }
  125.  
  126. proc msg_destroy {} {
  127.     global Config
  128.  
  129.     if {$Config(compressed_prompt) != 0} {
  130.     mprompt_clear
  131.     }
  132.     catch {destroy .msg}
  133. }
  134.  
  135. proc msg_tmp {mess} {
  136.     global Config
  137.  
  138.     msg_Make $mess 0
  139.     if {$Config(compressed_prompt) != 2} {
  140.     after 5000 {msg_destroy}
  141.     }
  142. }
  143.  
  144. proc msg_warn {mess} {
  145.     global Config
  146.  
  147.     msg_Make $mess 1
  148.     if {$Config(compressed_prompt) != 2} {
  149.     after 5000 {msg_destroy}
  150.     }
  151. }
  152.  
  153. #
  154. #    Group cascading menus
  155. # 
  156. #        pass group selection to nn
  157. proc gg {grp {menu ""}} {
  158.     global grp_x grp_y
  159.     global gm_type ev_param ev_type ev_input 
  160.     global EV_FUNCT token
  161.  
  162.     if {$menu != ""} {
  163.     update
  164. #    puts [winfo rootx .top.m.menu.$menu]
  165. #    puts [winfo rooty .top.m.menu.$menu]
  166. #    puts [winfo geometry  .top.m.menu.$menu]
  167.     scan  "[winfo geometry  .top.m.menu.$menu]" "%dx%d+%d+%d" sx sy x y
  168.     set ya [.top.m.menu.$menu yposition active]
  169.     } else {
  170.     scan  "[winfo geometry  .top.m.menu]" "%dx%d+%d+%d" sx sy x y
  171.     set ya [.top.m.menu yposition active]
  172.     }
  173.  
  174.     set grp_x [expr $sx/2+$x]
  175.     set grp_y [expr $y+$ya-6]
  176.     set gm_type "m"
  177.     set ev_param $grp
  178.     ev_type_menu
  179.     rec_c $EV_FUNCT $token(K_SEL_GROUP)
  180. }
  181.  
  182. #        display group jump menu
  183. proc gr_Make {} {
  184.     global grp_x grp_y
  185.     global list_cnt first_menu
  186.  
  187.     incr list_cnt
  188.  
  189.     if {[winfo exists .gr-popup]} {
  190.     destroy .gr-popup
  191.     }
  192.     menu .gr-popup
  193.     .gr-popup add command -label "Enter Group"
  194.     .gr-popup add separator
  195.     foreach i {"j)jump" "J)Jump read" "a)all"  "s)subject" "n)name" "e)either" \
  196.            "u)unread" "@)archive"} {
  197.     set a [string index $i 0]
  198.     set i [string range $i 2 end]
  199.     .gr-popup add command -label $i -accelerator $a -command "gr_select $a"
  200.     }
  201.  
  202.     if {![info exists grp_x]} {
  203.     if {[info exists .menu]} {
  204.         set grp_x [winfo rootx .menu]
  205.         set grp_y [winfo rooty .menu]
  206.     }
  207.     }
  208.     if {[info exists grp_x]} {
  209.     .gr-popup configure -tearoff no
  210.     tk_popup .gr-popup $grp_x [expr $grp_y-35]
  211.     grab release .gr-popup
  212.     if {![info exists first_menu]} {
  213. #        tkMenuBind .gr-popup Enter
  214.         set first_menu 1
  215.     }
  216.     
  217.     unset grp_x grp_y
  218.     update
  219.     }
  220. }
  221.  
  222. #        group jump menu selection
  223. proc gr_select {x} {
  224.     global ev_input  ev_type EV_CHAR 
  225.     global list_cnt      
  226.  
  227.     rec_c $EV_CHAR $x
  228.     .gr-popup unpost
  229.     destroy .gr-popup
  230.     set list_cnt 0
  231. }
  232.  
  233. proc gr_del {} {
  234.     global list_cnt      
  235.     #   fudgy variable to make sure window
  236.     #   isn't destroyed if it has to be reposted
  237.  
  238.     if {$list_cnt <= 1} {
  239.     if {[winfo exists .gr-popup]} {
  240.         destroy  .gr-popup
  241.     }
  242.     }
  243.     incr list_cnt -1
  244. }
  245.  
  246. #
  247. #    Group List
  248. #
  249. proc list_group {grp yc} {
  250.     set t [$grp get $yc.0 $yc.9999]
  251.     set l [expr [string first "\t" $t]-1]
  252.     if { $l > 0 } {
  253.     set t [string range $t 0 $l]
  254.     }
  255.     return $t
  256. }
  257.  
  258. #        pass group list selection to nn
  259. proc list_select {grp y} {
  260.     global gm_type ev_param ev_input ev_type 
  261.     global EV_FUNCT token
  262.  
  263.     set gm_type 'g'
  264.  
  265.     list_mark $grp $y
  266.  
  267.     set t [list_group $grp.list $y]
  268. #       puts stderr "$grp<$y>$t-"
  269.     set ev_param $t
  270.     if {$grp == ".folders"} {
  271.     set ev_param "+$ev_param"
  272.     }
  273.     ev_type_menu
  274.     rec_c $EV_FUNCT $token(K_SEL_GROUP)
  275. }
  276.  
  277. #        replace a group list entry
  278. proc list_update {ent y} {
  279. #    puts "list_update $ent $y"
  280.     if {$y >= 0} {
  281.     set nm [.groups.list tag names $y.0]
  282.     .groups.list delete $y.0 $y.9999
  283.     .groups.list insert $y.0 $ent $nm
  284.     }
  285. }
  286.  
  287. proc list_add {ent y} {
  288. #     puts "list_add $ent $y"
  289.     .groups.list insert end "$ent\n"
  290. }
  291.  
  292. proc list_flag {type rc {y 0} } {
  293.     global newsrc_sequence
  294.  
  295. #    puts "list_flag $type $rc $y"
  296.  
  297.     if {$y >=  0} {
  298.     if {$y == 0} {
  299.         scan [.groups.list index end] %d.%d y x
  300.         set y [expr $y-2]
  301.     }
  302.  
  303.     if {$type == "n"} {
  304.         .groups.list insert $y.9999 "\t "
  305.         .groups.list insert $y.9999 N lred
  306.     } elseif {$type == "u"} {
  307.         .groups.list insert $y.9999 "\t "
  308.         .groups.list insert $y.9999 U lblue
  309.     } elseif {$rc > 0  }  {
  310.         .groups.list insert $y.9999 "\t "
  311.     }    
  312.     if {$rc > 0  && $newsrc_sequence == 1}  {
  313.         .groups.list insert $y.9999 "\|" lgreen
  314.     }
  315.     }
  316. }
  317.  
  318. proc list_flag_raise {} {
  319.     .groups.list tag raise lred
  320.     .groups.list tag raise lblue
  321.     .groups.list tag raise lgreen
  322. }
  323.  
  324. proc group_save {n} {
  325.     global gpos_save
  326.     set gpos_save $n
  327. }
  328.  
  329. proc group_ret {t} {
  330.     global gpos_save
  331.     if {$t == "r"} {
  332.     list_mark .groups $gpos_save
  333.     }
  334. }
  335.  
  336. proc list_pos_save {} {
  337.     global list_pos_s
  338.     catch {
  339.     set n [.groups.list get sely.first sely.last]
  340.     scan $n "%s" list_pos_s
  341.     }
  342. }
  343.  
  344. proc list_pos_ret {} {
  345.     global list_pos_s
  346.     catch {list_mark .groups [lookup_group_pos $list_pos_s]}
  347. }
  348.  
  349. proc list_cl {} {
  350.     global Config
  351.  
  352.     .groups.list configure -width $Config(group_list_width)
  353.     list_tabs .groups.list
  354. }
  355.  
  356. proc list_clear {} {
  357.     if {[winfo exists .groups] != 0} {
  358.     list_pos_save
  359.     .groups.list delete 0.0 end
  360.     list_tabs .groups.list
  361.     grp_list
  362.     list_pos_ret
  363.     }
  364. }
  365.  
  366. proc list_reset {} {
  367.     if {[winfo exists .groups] != 0} {
  368.     list_pos_save
  369.     destroy .groups
  370.     list_Make .groups grp_list
  371.     thread_Make
  372.     list_pos_ret
  373.     }
  374. }
  375.  
  376. #        mark current group 
  377. proc list_mark {w y} {
  378.     global Config
  379.  
  380.     if {[winfo exists $w] != 0} {
  381.     if {$y > 0} {
  382.         $w.list tag remove sely 0.0 end
  383.         $w.list tag add sely $y.0 [expr $y+1].0
  384.         $w.list tag raise sely
  385.  
  386.         set t [$w.scroll get]
  387.         scan $t "%f %f" first last
  388.         set lines [$w.list index end]
  389.         set yl [expr $lines*$last]
  390.         set yf [expr $lines*$first]
  391. #        puts "lines=$lines first=$first last=$last yl=$yl yf=$yf y=$y"
  392.         if {($y > [expr $yl-$Config(group_list_page)]) || \
  393.             ($y < [expr $yf+$Config(group_list_page)])} {
  394.         $w.list yview [expr $y-4]
  395.         }
  396.     }
  397.     }
  398. }
  399.  
  400. #         create group list
  401. proc list_Make {grp flist} {
  402.     if {[winfo exists $grp] == 0} {
  403.     list_mk $grp
  404.     $flist
  405.     }
  406. }
  407.  
  408. proc group_handle_Make {w} {
  409.     global color_bd
  410.  
  411.     frame $w-handle -height 12 -width 12 -relief raised -borderwidth 2 \
  412.     -cursor sb_h_double_arrow -background $color_bd
  413.     place $w-handle -rely 0.05 -x -12 -in $w
  414.  
  415.     set xsize [lindex [.groups.thr.y configure -width] 4]
  416.     bind $w-handle <Button-1> "group_drag $w 0 $xsize"
  417.     bind $w-handle <B1-Motion> "group_drag $w %x $xsize"
  418.     bind $w-handle <ButtonRelease-1> "group_drag_resize $w %x $xsize"
  419.     frame $w-bar -width 3 -height 1800 -bg red
  420.     balloonHelp_traverse $w-handle
  421. }
  422.  
  423. proc group_drag {w x xsize} {
  424.     place $w-bar -y [top_y  $w 0] -x [expr [top_x  $w $x] - $xsize] -anchor n
  425. }
  426.     
  427. proc group_drag_resize {w x xsize} {
  428.  
  429.     if {$x < 0} {
  430.     set xsize [expr $xsize*2]
  431.     }
  432.     set curr [expr [top_x  $w $x] - $xsize]
  433.  
  434.     group_drag_resize_do $w $curr
  435.  
  436.     set nycurr [winfo height .groups.t]
  437.     pack propagate .groups.t 0
  438.     .groups.t configure -width $curr -height $nycurr
  439.  
  440.     list_tabs .groups.list
  441.     place  forget $w-bar
  442. }
  443.  
  444. proc group_drag_resize_do {w curr} {
  445.     global Config
  446.  
  447.     pack propagate .groups.t false
  448.     pack propagate .groups.t true
  449.     set menu_top [top_x .groups.list 0]
  450.     set menu_height [winfo width .groups.list]
  451.     set menu_chars [lindex [.groups.list configure -width] 4]
  452.     set new_size [expr (($curr-$menu_top)*$menu_chars)/$menu_height]
  453.     .groups.list configure -width $new_size
  454.     set Config(group_list_width) $new_size
  455. }
  456.  
  457. proc group_color {pat col} {
  458.     global color_list
  459.  
  460.     set start 0.0
  461.     .groups.list  tag configure b$col -background  $col -foreground black
  462.     lappend color_list b$col
  463.     while {[set fnd [.groups.list search $pat $start end]]  != "" } {
  464.     scan $fnd %d yc
  465.     .groups.list tag add b$col $yc.0 [expr $yc+1].0
  466.     set start [expr $yc+1].0
  467.     }
  468.     update
  469. }
  470.     
  471. proc group_color_clear {} {
  472.      global color_list
  473.  
  474.     foreach c $color_list {
  475.     .groups.list  tag remove $c 0.0 end
  476.     }
  477. }
  478.  
  479. proc group-search {grp up} {
  480.     global grp_x grp_y
  481.  
  482.     set srch [$grp.search.txt get]
  483.     if {$srch == ""} {
  484.     return
  485.     }
  486.  
  487.     if {$up} {
  488.     set start 999999.1
  489.     scan [$grp.list tag ranges sely] "%s" start
  490.     set fnd [$grp.list  search -backwards  $srch $start 0.0]
  491.     } else {
  492.     set start 0.1
  493.     scan [$grp.list tag ranges sely] "%s %s" d start
  494.     set fnd [$grp.list search  $srch $start end]
  495.     } 
  496.  
  497.     if {$fnd != ""} {
  498.     scan $fnd %d i
  499.     list_select $grp $i
  500.     list_mark $grp $i
  501.     set grp_x [expr [winfo rootx $grp.search.bt]+15]
  502.     set grp_y [winfo rooty $grp.search.bt] 
  503.     return
  504.     }
  505.  
  506.     msg_tmp "Group no found"
  507. }
  508.  
  509. proc group-srch {grp} {
  510.     frame $grp.search
  511.  
  512.     button $grp.search.bt -image down -command "group-search $grp 0" -bd 2 \
  513.     -relief raised
  514.     button  $grp.search.bf -image up  -command "group-search $grp 1"\
  515.     -bd 2 -relief raised
  516.     entry $grp.search.txt -relief sunken 
  517.     pack $grp.search.bt $grp.search.txt $grp.search.bf -side left  -pady 2 
  518.  
  519.     bind $grp.search.txt <Return> "group-search $grp 0; break"
  520. }
  521.  
  522.  
  523. proc list_press {grp window x y} {
  524.     global grp_x grp_y
  525.  
  526.     scan [$window index @$x,$y] %d.%d yc xc
  527.     set i [$window index @$x,$y]
  528. #puts "x=$x y=$y i=$i xc=$xc yc=$yc"
  529.     list_select $grp $yc
  530.     set x [expr [winfo rootx $window]+$x]
  531.     set y [expr [winfo rooty $window]+$y]
  532.     set grp_x $x
  533.     set grp_y $y 
  534. }
  535.  
  536. proc list_tabs {w} {
  537.     global  Config
  538.  
  539. #   need to substantiate the window to get the right size
  540.     update
  541.     set t2 [winfo width $w]
  542.  
  543.     if {$Config(group_list_all)} {
  544.     $w configure -tabs "[expr $t2-60] right [expr $t2-23]  right [expr $t2-10] right $t2 right"
  545.     } else {
  546.     $w configure -tabs "[expr $t2-30] right [expr $t2-8]  right $t2 right"
  547.     }
  548. }
  549.  
  550. proc list_mk {grp} {
  551.     global color_w color_bs Config nn_x_dir drag_id newsrc_sequence
  552.  
  553.     set newsrc_sequence [nn_get_var newsrc-sequence]
  554.  
  555.     set drag_id 0
  556.     if {$grp == ".groups"} {
  557.     if {$Config(single_main)} {
  558.         .top.f.func.w entryconfigure 1 -state disabled
  559.         frame  $grp -relief ridge -borderwidth 2
  560.     } else {
  561.         .top.f.func.w entryconfigure 1 -state normal
  562.         toplevel $grp
  563.         if {[info exists Config(.groups)]} {
  564.         set geom $Config(.groups)
  565.         }
  566.     }
  567.     } else {
  568.     toplevel $grp
  569.     if {[info exists Config(.folders)]} {
  570.         set geom $Config(.folders)
  571.     }
  572.     }
  573.  
  574.     frame $grp.t
  575.     frame $grp.t.b -borderwidth 2  -relief ridge
  576.     group-srch $grp
  577.     if {$grp ==  ".groups"} {
  578.     checkbutton $grp.mod -text Modify -command {modify_Make} \
  579.         -relief raised -bd 2 -variable groups_mod
  580.     pack $grp.mod -in $grp.t.b -side left -padx 5
  581.     }
  582.     pack $grp.search -in $grp.t.b
  583.     pack $grp.t -side top -fill both
  584.  
  585.     if {!$Config(single_main) || $grp !=  ".groups"} {
  586.     button $grp.t.dis  -text "Dismiss" -command "destroy $grp"
  587.     pack  $grp.t.dis -side right 
  588.     }
  589.     button $grp.t.help  -text "Help" -command "put_extended {help nn-tk-groups}"
  590.     pack  $grp.t.help -side right 
  591.     pack $grp.t.b -side left -expand y
  592.  
  593.     scrollbar $grp.scroll -command "$grp.list yview"
  594.     text $grp.list -yscroll "$grp.scroll set"  -relief raised -borderwidth 0 \
  595.     -cursor left_ptr -wrap none -spacing1 3
  596.     text_bindings $grp.list
  597.  
  598.     $grp.list  tag configure sely  -background  $color_bs -relief raised -borderwidth 1 
  599.     $grp.list  tag configure lred -foreground  red 
  600.     $grp.list  tag configure lblue -foreground  blue 
  601.     $grp.list  tag configure lgreen -foreground  green
  602.  
  603.     bind $grp.list <B1-Motion> {break}
  604.     bind $grp.list <Button-1> "list_press $grp %W %x %y"
  605.     bind $grp.list <ButtonRelease-1> {after cancel $drag_id}
  606.  
  607.     pack $grp.scroll -side right -fill y
  608.     pack $grp.list -side left -expand yes -fill both
  609.  
  610.     $grp.list configure -width $Config(group_list_width)
  611.     if {!$Config(single_main) || $grp !=  ".groups"} {
  612.     $grp.list configure -exportselection 0 -setgrid 1 
  613.     if {[info exists geom]} {
  614.         wm geometry $grp $geom
  615.     }
  616.     update
  617.     list_tabs $grp.list
  618.     } else {
  619.     $grp.list configure -exportselection 0 -setgrid 0 
  620.     pack $grp  -fill y -side left -padx 4 -before .top
  621.     }
  622.     balloonHelp_traverse $grp
  623. }
  624.  
  625. #
  626. #       Yes/No popup
  627. #
  628. proc y_prompt {} {
  629.     global prompt_buf
  630.     toplevel .yp 
  631.     regsub -all "\\1" $prompt_buf "" prompt_buf
  632.     regsub -all \x0d $prompt_buf "" prompt_buf
  633.     regsub -all \x01 $prompt_buf "" prompt_buf
  634.     wm transient .yp .
  635.     wm geometry .yp +300+300
  636.     message .yp.t -text $prompt_buf -aspect 1500
  637.     frame .yp.f -relief sunken -borderwidth 2
  638.     button .yp.f.yes -text "YES" -command "prompt_r y"
  639.     button .yp.f.no -text "NO" -command "prompt_r n"
  640.  
  641.     pack .yp.f.no -side left -padx 10m -pady 5m 
  642.     pack .yp.f.yes -side right -padx 10m -pady 5m
  643.     pack .yp.t -side top -expand yes -fill x
  644.     pack .yp.f -side top -fill both
  645.  
  646.     grab set .yp
  647.     focus .yp
  648.     bind .yp y {prompt_r y}
  649.     bind .yp Y {prompt_r y}
  650.     bind .yp n {prompt_r n}
  651.     bind .yp N {prompt_r n}
  652.     bind .yp escape {prompt_r n}
  653.     bind .yp <Key-Return> {prompt_r y}
  654. }
  655.  
  656. proc y_destroy {} {
  657.     if {[winfo exists .yp]} {
  658.     destroy .yp
  659.     }
  660. }
  661.  
  662. proc prompt_r {c} {
  663.     destroy .yp
  664.     put_key $c
  665. }
  666.  
  667. #
  668. #    Prompting popup
  669. #
  670. proc prompt_Make {} {
  671.     global color_w Config
  672.  
  673.     if {($Config(separate_prompt) == 1) && ($Config(compressed_prompt) != 2)} {
  674.     toplevel .prompt
  675.  
  676.     wm transient .prompt .
  677.     wm title .prompt "NN Prompt"
  678.     } else {
  679.     frame .prompt
  680.     }
  681.     
  682.     text .prompt.pr1 -relief raised -bd 2 \
  683.     -height 1
  684.     text .prompt.pr2 -relief raised -bd 2 \
  685.     -height 1
  686.     text .prompt.pr3 -relief raised -bd 2 \
  687.     -height 1
  688.  
  689.     if {($Config(separate_prompt) == 1) && ($Config(compressed_prompt) != 2)} {
  690.     .prompt.pr1 configure -setgrid true
  691.     .prompt.pr2  configure -setgrid true
  692.     .prompt.pr3  configure -setgrid true
  693.     }
  694.     if {$Config(compressed_prompt) != 2} {
  695.     pack .prompt.pr1 .prompt.pr2 .prompt.pr3 -side top \
  696.         -fill both -expand yes
  697.     }
  698.  
  699.     bind .prompt.pr1 <ButtonRelease-2> break
  700.     bind .prompt.pr2 <ButtonRelease-2> break
  701.     bind .prompt.pr3 <ButtonRelease-2> break
  702.  
  703.     bind .prompt <Destroy> prompt_d
  704.     bind .prompt.pr1 <2> prompt_insert
  705.     text_bindings .prompt.pr1
  706.     bind .prompt.pr2 <2> prompt_insert
  707.     text_bindings .prompt.pr2
  708.     bind .prompt.pr3 <2> prompt_insert
  709.     text_bindings .prompt.pr3
  710.  
  711.  
  712.     if {($Config(separate_prompt) == 1) && ($Config(compressed_prompt) != 2)} {
  713.     if {[info exists Config(.prompt)]} {
  714.         wm geometry  .prompt $Config(.prompt)
  715.     }
  716.     } 
  717. }
  718.  
  719. proc prompt_insert {} {
  720.     catch {set t [selection get]}
  721.     set n [string length $t]
  722.     for {set i 0} {$i < $n} {incr i} {
  723.     put_key [string index $t $i]
  724.     }
  725. }
  726.  
  727. proc prompt_clear {} {
  728.     global Config
  729.  
  730.     catch {
  731.     pprompt_clear 
  732.     .prompt.pr1 delete 0.0 end
  733.     .prompt.pr2 delete 0.0 end
  734.     .prompt.pr3 delete 0.0 end
  735.     if {($Config(separate_prompt) == 1) && ($Config(compressed_prompt) != 2)} {
  736.         wm withdraw .prompt
  737.         pack forget .prompt
  738.     }
  739.     }
  740. }
  741.  
  742. proc prompt_clrline {w pos} {
  743.  
  744.     $w delete $pos end
  745.     if {$w != ".menu-pr"} {
  746.     pprompt_clrline $pos
  747.     }
  748. }
  749.  
  750. proc prompt_restore {} {
  751.     global Config
  752.  
  753.     if {($Config(separate_prompt) == 1) && ($Config(compressed_prompt) != 2)} {
  754.     if {[winfo exists .prompt] == 0} {
  755.         prompt_Make
  756.     } else {
  757.         if {[winfo toplevel .prompt] == ".prompt"} {
  758.         wm deiconify .prompt
  759.         catch {
  760.             pack configure .prompt -after .more -side top -fill x
  761.         }
  762.         }
  763.     }
  764.     }
  765. }
  766.  
  767. proc prompt_d {} {
  768.     prompt_delete
  769. } 
  770. #
  771. #    display popup
  772. #
  773. proc display_l {} {
  774.     global display_l_t
  775.  
  776.     if {[winfo exists .display] == 0} {
  777.     display_Make
  778.     }
  779.  
  780.     set x $display_l_t
  781.     scan [.display.t index end] "%d." l
  782.     incr l -1
  783.  
  784.     set offset 0
  785.  
  786.     while {[regexp -indices "\01(\[^\01\]+)\01" $x pos]} {
  787.     scan $pos "%d %d" s f
  788.     set xt [string range $x 0 $f]
  789.     regsub -all \x01 $xt "" xt
  790.     .display.t insert end $xt
  791.     .display.t tag add out $l.[expr $offset+$s] $l.[expr $offset+$f-1]
  792.     set x [string range $x [expr $f+1] 999]
  793.     incr offset [expr $f-1]
  794.     }
  795.     regsub -all \x01 $x "" x
  796.  
  797.     .display.t insert end $x
  798. }
  799.  
  800. proc display_Make {} {
  801.     global color_w Config
  802.  
  803.     if {[winfo exists .display] == 0} {
  804.     toplevel .display
  805.  
  806.     frame .display.b 
  807.     button .display.b.b  -text "Dismiss" -command "destroy .display"
  808.     pack  .display.b.b -side right 
  809.     pack .display.b -side top -fill x
  810.  
  811.     text .display.t -relief raised -bd 2 -setgrid true \
  812.         -height 25 -width 80  -yscrollcommand ".display.s set" \
  813.         -wrap none
  814.     scrollbar .display.s -command ".display.t yview"
  815.     pack .display.t -side left -expand yes -fill both
  816.     pack .display.s -side left -fill y
  817.         .display.t tag configure out -background black -foreground white
  818.     wm title .display "NN help"
  819.     if {[info exists Config(.display)]} {
  820.         wm geometry .display $Config(.display)
  821.     }
  822.     } else {
  823.     .display.t delete 0.0 end
  824.     }
  825. }
  826.  
  827. #
  828. # deal with draging selection
  829. #
  830. proc modify_drag {y } {
  831.     global mod_prev tkPriv drag_id
  832.  
  833.     set resced 1
  834.     if {$y >= [winfo height .groups.list]} {
  835.     .groups.list yview scroll 2 units
  836.     } elseif {$y < 0} {
  837.     .groups.list yview scroll -2 units
  838.     } else {
  839.     set resced 0
  840.     }
  841.  
  842.     scan [.groups.list index @0,$y] %d yc
  843.     if {$yc != $mod_prev} {
  844.     if {$yc > $mod_prev} {
  845.         set n 1
  846.     } else {
  847.         set n -1
  848.     }
  849.     set ychk [expr $yc+$n]
  850.     for {set i [expr $mod_prev+$n]} {$i != $ychk} {incr i $n} {
  851.         modify_toggle_select $i
  852.     }
  853.     set mod_prev $yc
  854.     }
  855.  
  856.     after cancel $drag_id
  857.     if {$resced} {
  858.     set drag_id [after 100 "modify_drag $y"]
  859.     }    
  860. }
  861.  
  862. proc modify_toggle_select {i} {
  863.     if {[lsearch -exact [.groups.list tag name $i.0] sely] < 0} {
  864.     .groups.list tag add sely $i.0 [expr $i+1].0
  865.     } else {
  866.     .groups.list tag remove sely $i.0 [expr $i+1].0
  867.     }
  868. }
  869.  
  870. proc modify_clear {} {
  871.     .groups.list tag remove sely 0.0 end
  872. }
  873.               
  874. proc modify_all {} {
  875.     .groups.list tag add sely 0.0 end
  876. }
  877.               
  878. proc modify_sel {y} {
  879.     global mod_prev
  880.  
  881.     scan [.groups.list index @0,$y] %d yc
  882.     modify_toggle_select $yc
  883.     set mod_prev $yc
  884. }
  885.  
  886. proc modify_choose {cmd} {
  887.     set rg [.groups.list tag ranges sely]
  888. #    puts "=$rg"
  889.     set l [expr [llength $rg]/2]
  890.     for {set i 0} {$i < $l} {incr i} {
  891.     scan [lindex $rg [expr $i*2]] %d st
  892.     scan [lindex $rg [expr ($i*2)+1]] %d fn
  893. #    puts "-$st $fn"
  894.     for {set j $st} {$j < $fn} {incr j} {
  895.         scan [.groups.list get $j.0 $j.9999] %s grp
  896.         $cmd $grp
  897.     }
  898.     }
  899.     if {"$cmd" != "modify_sub"} {
  900.     end_subscribe
  901.     }
  902.     list_clear
  903. }
  904.  
  905. # select items in group list containing a string
  906. proc modify_select {} {
  907.     set srch [.modify.sl.s.e get]
  908.     if {$srch == ""} {
  909.     return
  910.     }
  911.     set start 0.0
  912.     while {[set fnd [.groups.list search $srch $start end]]  != "" } {
  913.     scan $fnd %d yc
  914.     .groups.list tag add sely $yc.0 [expr $yc+1].0
  915.     set start [expr $yc+1].0
  916.     }
  917. }
  918.     
  919. proc modify_sub {g} {
  920.     subscribe $g s
  921. }
  922.  
  923. proc modify_unsub {g} {
  924.     subscribe $g u
  925. }
  926.  
  927. proc modify_new {g} {
  928.     subscribe $g o
  929. }
  930.  
  931. # call C code for cutting part out of newsgroup sequence chain
  932. proc modify_cut {s f} {
  933.     scan $s %d st
  934.     scan $f %d fn
  935.     set snm [list_group .groups.list $st]
  936.     set fnm [list_group .groups.list $fn]
  937. #    puts "modify_cut $snm $fnm"
  938.     group_cut $snm $fnm
  939. }
  940.  
  941. proc modify_put_first {} {
  942.     modify_move 1
  943. }
  944.  
  945. proc modify_put_last {} {
  946.     scan [.groups.list index end] %d yc
  947.     modify_move [expr $yc-1]
  948. }
  949.    
  950. proc modify_put_after {} {
  951.     set srch [.modify.p.g.e get]
  952.     if {[set fnd [.groups.list search $srch 0.0 end]]  != ""} {
  953.     scan $fnd %d yc
  954.     modify_move $yc
  955.     } else {
  956.     msg_tmp "Not found"
  957.     }
  958. }
  959.     
  960. proc modify_paste {y} {
  961.     global tkPriv
  962.  
  963.     if {!$tkPriv(mouseMoved)} {
  964.     scan [.groups.list index @0,$y] %d yc
  965.     modify_move $yc
  966.     }
  967. }
  968.  
  969. proc modify_fix_sequence {} {
  970.     toplevel .mess
  971.     message .mess.m1 -text "Setting newsrc-sequence." -aspect 800
  972.     message .mess.m2 -text "Should the .newsrc file be used to determine the \
  973. entire newsgroup sequence or just the part matching RC in the init file sequence.\
  974. If you haven't set up a .nn/init file use Newsrc only." \
  975.     -aspect 500
  976.     pack .mess.m1 .mess.m2
  977.     frame .mess.f -relief ridge -borderwidth 2
  978.     button .mess.f.only -text "Newsrc only" -command "modify_fix_done 2"
  979.     button .mess.f.init -text "Init RC" -command "modify_fix_done 1"
  980.     pack .mess.f.only -side left -padx 10 -pady 5
  981.     pack .mess.f.init -side right -padx 10 -pady 5
  982.     pack .mess.f -expand yes -fill both
  983. }
  984.  
  985. proc modify_fix_done {flag} {
  986.     global variables_m variables_val
  987.  
  988.     set variables_m(newsrc-sequence) 1
  989.     set variables_val(newsrc-sequence) $flag
  990.     nn_set_var newsrc-sequence $flag
  991.  
  992.     variables_save
  993.     destroy .mess
  994. }
  995.  
  996. #
  997. # move groups in group list, at the same time
  998. # rearrange the newsgroup sequence chains in the
  999. # C code
  1000. #
  1001. proc modify_move {yc} {
  1002.     if {[nn_get_var newsrc-sequence] == 0} {
  1003.     modify_fix_sequence
  1004.     }
  1005.     set grp_paste [list_group .groups.list $yc]
  1006.     #      test if pasting at end
  1007.     if {$grp_paste == ""} {
  1008.     set grp_paste [list_group .groups.list [expr $yc-1]]
  1009.     set pos a
  1010.     } else {
  1011.     set pos b
  1012.     }
  1013.  
  1014.     .groups.list tag delete point
  1015.     .groups.list tag add point $yc.0 $yc.9999
  1016.  
  1017.     #    puts "$grp_paste $yc"
  1018.     set rg [.groups.list tag ranges sely]
  1019.     set l [expr ([llength $rg]/2)-1]
  1020.  
  1021.     #      check to make sure a range isn't being moved into itself
  1022.     for {set i $l} {$i >= 0} {incr i -1} {
  1023.     set s [lindex $rg [expr $i*2]] 
  1024.     set f [lindex $rg [expr ($i*2)+1]]
  1025.     if {($yc >= $s) && ($yc<$f)} {
  1026.         bell
  1027.         return 0
  1028.     }
  1029.     }
  1030.  
  1031.     text .groups.tmp
  1032.     #      process backwards so indexs don't change with deletions
  1033.     for {set i $l} {$i >= 0} {incr i -1} {
  1034.     set s [lindex $rg [expr $i*2]] 
  1035.     set f [lindex $rg [expr ($i*2)+1]]
  1036.  
  1037.     scan [.groups.list index end] "%d" fin
  1038.     if {$fin == $f} {
  1039.         set f [expr $f-1]
  1040.     }
  1041.     if {$f != $s} {
  1042.         modify_cut $s [expr $f-1]
  1043.         .groups.tmp insert 0.0 [.groups.list get $s $f]
  1044.         .groups.list delete $s $f
  1045.     }
  1046.     }
  1047.     
  1048.     group_paste $grp_paste $pos
  1049.     #    puts [lookup_group_pos $grp_paste].0
  1050.     scan [.groups.list tag  ranges point] %d yc
  1051.     .groups.list insert $yc.0 \
  1052.     [.groups.tmp get  0.0 "end - 1 chars"]
  1053.     destroy .groups.tmp
  1054. }
  1055.  
  1056. proc modify_Make {} {
  1057.     global Config groups_mod groups_pt
  1058.  
  1059.     if {$groups_mod} {
  1060.     toplevel .modify
  1061.  
  1062.     frame .modify.b
  1063. #    -borderwidth 2  -relief ridge
  1064.     button .modify.b.d -text "Dismiss" -command "modify_destroy"
  1065.     button .modify.b.h -text "Help" -command "put_extended {help nn-tk-modify}"
  1066.     pack .modify.b.d -side right
  1067.     pack .modify.b.h -side right
  1068.     pack .modify.b  -fill x
  1069.     
  1070.     label .modify.t -text "MODIFY GROUP LIST"
  1071.  
  1072.     frame .modify.sl -borderwidth 2  -relief ridge
  1073.     label .modify.sl.t -text "Manipulate slection"
  1074.     frame .modify.sl.s
  1075.     button .modify.sl.s.b -text "Select" -command "modify_select"
  1076.     entry .modify.sl.s.e
  1077.     button .modify.sl.sa -text "Select All" -command "modify_all"
  1078.     button .modify.sl.cl -text "Select None" -command "modify_clear"
  1079.     pack .modify.sl.s.b .modify.sl.s.e -side left
  1080.     pack  .modify.sl.t .modify.sl.sa .modify.sl.cl -fill x
  1081.  
  1082.     frame .modify.s -borderwidth 2  -relief ridge
  1083.     label .modify.s.t -text "Subscription"
  1084.     button .modify.s.sub -text "Subscribe" -command "modify_choose modify_sub"
  1085.     button .modify.s.unsub -text "unSubscribe" -command "modify_choose modify_unsub"
  1086.     button .modify.s.new -text "Clear new" -command "modify_choose modify_new"
  1087.     pack .modify.s.t .modify.s.sub .modify.s.unsub .modify.s.new  -fill x
  1088.  
  1089.     frame .modify.p -borderwidth 2  -relief ridge
  1090.     label .modify.p.t -text "Move Groups"
  1091.     button .modify.p.first -text "Put First" -command "modify_put_first"
  1092.     button .modify.p.last -text "Put Last" -command "modify_put_last"
  1093.     frame .modify.p.g
  1094.     button .modify.p.g.b -text "Put Before" -command "modify_put_after"
  1095.     entry .modify.p.g.e
  1096.     pack .modify.p.g.b .modify.p.g.e -side left -fill x
  1097.     pack .modify.p.t .modify.p.first .modify.p.last .modify.p.g -fill x
  1098.  
  1099.     pack .modify.t .modify.sl .modify.s .modify.p -fill x 
  1100.  
  1101.     balloonHelp_traverse .modify
  1102.     balloonHelp .groups.list "Select groups with the left mouse button, paste selected groups to a different position with the middle mouse button"
  1103.  
  1104.     bind .groups.list <Button-1> "modify_sel %y; break"
  1105.     bind .groups.list <B1-Motion> "modify_drag %y; break"
  1106.     bind .groups.list <ButtonRelease-2> "modify_paste %y; break"
  1107.     bind .groups.list <B1-Leave> "break"
  1108.     bind .groups.list <B1-Enter> "break"
  1109.     bind .modify <Destroy> modify_destroy
  1110.  
  1111.     list_pos_save
  1112.     .groups.list tag remove sely 0.0 end
  1113.     if {[info exists Config(.modify)]} {
  1114.         wm geometry  .modify $Config(.modify)
  1115.     }
  1116.     } else {
  1117.     modify_destroy
  1118.     }
  1119. }
  1120.  
  1121. proc modify_destroy {} {
  1122.     global groups_mod
  1123.  
  1124.     balloonHelp_traverse .groups.list
  1125.     .groups.list tag remove sely 0.0 end
  1126.     bind .groups.list <Button-1> "list_press .groups %W %x %y"
  1127.     bind .groups.list <B1-Motion> {break}
  1128.     catch {destroy .modify}
  1129.     list_pos_ret
  1130.     set groups_mod 0
  1131. }
  1132.  
  1133. #
  1134. # Thread structure display
  1135. #
  1136. proc thread_Make {} {
  1137.     global Config
  1138.     global areaX1 areaY1 areaX2 areaY2
  1139.  
  1140.     frame .groups.thr
  1141.     scrollbar .groups.thr.x -command ".groups.c xview" -width 7 -orient horiz 
  1142.     scrollbar .groups.thr.y -command ".groups.c yview" 
  1143.     canvas .groups.c -relief sunken -borderwidth 0 \
  1144.     -height $Config(thread_height) \
  1145.         -width 0 \
  1146.     -scrollregion {0 0 1500 1000} \
  1147.     -xscrollcommand ".groups.thr.x set" \
  1148.     -yscrollcommand ".groups.thr.y set"
  1149.     balloonHelp_traverse .groups.c
  1150.  
  1151.     if {$Config(thread_height) != 0} {
  1152.         pack .groups.thr.y -side right -fill y
  1153.         pack .groups.thr.x -side bottom -fill x
  1154.         pack .groups.c -side top  -fill both -in .groups.thr
  1155.         pack .groups.thr -side top  -fill both -before .groups.t
  1156.     }
  1157.  
  1158.     bind .groups.c <2> ".groups.c scan mark %x %y"
  1159.     bind .groups.c <B2-Motion> ".groups.c scan dragto %x %y"
  1160.     bind  .groups.c <1> "thread_draw_init %x %y 1"
  1161.     bind  .groups.c <B1-Motion> "thread_draw %x %y"
  1162.     bind  .groups.c <ButtonRelease-1> "thread_draw_in"
  1163.     bind  .groups.c <Button-3> "thread_draw_init %x %y 0"
  1164.     bind  .groups.c <B3-Motion> "thread_draw %x %y"
  1165.     bind  .groups.c <ButtonRelease-3> "thread_draw_in"
  1166. }
  1167.  
  1168. proc thread_nmark {x y} {
  1169.     global nid bid nprev bprev Config
  1170.  
  1171.     if {$Config(thread_height) != 0 && [info exists nid($x,$y)]} {
  1172.         # mark current node
  1173.         .groups.c itemconfigure $nid($x,$y) -fill white
  1174.         .groups.c itemconfigure $bid($x,$y) -fill red -outline red
  1175.         .groups.c lower $bid($x,$y)
  1176.  
  1177.         # unmark previous node
  1178.         if {[info exists nprev]} {
  1179.             .groups.c itemconfigure $nprev -fill black
  1180.             .groups.c itemconfigure $bprev -fill ""
  1181.         }
  1182.  
  1183.         # scroll so current node is visible
  1184.         scan [.groups.c bbox $nid($x,$y)] "%d %d %d %d" x1 y1 x2 y2
  1185.         scan [.groups.c cget -scrollregion] "%d %d %d %d" lx1 ly1 lx2 ly2
  1186.  
  1187.         #    puts [.groups.thr.y get]
  1188.  
  1189.         set xs [expr $x1*1.0/$lx2]
  1190.         set ys [expr $y1*1.0/$ly2]
  1191.         set xf [expr $x2*1.0/$lx2]
  1192.         set yf [expr $y2*1.0/$ly2]
  1193.  
  1194.         scan [.groups.thr.x get] "%f %f" xmin xmax
  1195.         scan [.groups.thr.y get] "%f %f" ymin ymax
  1196.  
  1197.         if {$xs < $xmin || $xf > $xmax} {
  1198.             .groups.c xview moveto [expr $xs-($xf-$xs)*3 ]
  1199.         } else {
  1200.             .groups.c xview moveto $xmin
  1201.         }
  1202.  
  1203.         if {$ys < $ymin || $yf > $ymax} {
  1204.             .groups.c yview moveto [expr $ys-($yf-$ys)*0.5 ]
  1205.         } else {
  1206.             .groups.c yview moveto $ymin
  1207.         }
  1208.  
  1209. # remember last node
  1210.         set nprev $nid($x,$y)
  1211.         set bprev $bid($x,$y)
  1212.     }
  1213. }
  1214.  
  1215. proc thread_button {box_id} {
  1216.     global token th_num
  1217.     
  1218.     set a_num $th_num($box_id)
  1219.  
  1220.     set w  [lindex [.groups.c itemconfigure $box_id -width] 4]
  1221.     if {$w == 1} {
  1222.     .groups.c itemconfigure $box_id -width 2
  1223.     } else {
  1224.     .groups.c itemconfigure $box_id -width 1
  1225.     }
  1226.     toggle_select $a_num
  1227.     put_funct $token(K_READ_GROUP_UPDATE) "m"
  1228. }
  1229.  
  1230. proc thread_set {box_id on} {
  1231.     global th_num
  1232.  
  1233.     if {[info exists th_num($box_id)]} {
  1234.     incr on
  1235.     set w  [lindex [.groups.c itemconfigure $box_id -width] 4]
  1236.     if {$w != $on} {
  1237.         .groups.c itemconfigure $box_id -width $on
  1238.         toggle_select $th_num($box_id)
  1239.     }
  1240.     }
  1241. }
  1242.   
  1243. proc thread_node {x y selected a_num} {
  1244.     global thread_text nid bid th_num
  1245.  
  1246.     set t $thread_text
  1247.     set l [llength $t]
  1248.  
  1249.     if {$l > 1} {
  1250.     set c1 [string range [lindex $t 0] 0 0]
  1251.     set c2 " "
  1252.     set c2 [string range [lindex $t 1] 0 0]
  1253.     set c3 " "
  1254.     if {[llength $t] > 2} {
  1255.         set c3 [string range [lindex $t [expr [llength $t]-1]] 0 0]
  1256.     }
  1257.     set node "$c1$c2$c3"
  1258.     } else {
  1259.     set node  [string range $t 0 2]
  1260.     }
  1261.     set n_id [.groups.c create text [expr 33*$x+30] [expr 22*$y+10] \
  1262.             -text $node -anchor ne -tags nodes \
  1263.             -font [option get .groups.c font {} ]]
  1264.     set nid($x,$y) $n_id
  1265.     set box [.groups.c bbox $n_id]
  1266.     set x1 [expr [lindex $box 0]-2]
  1267.     set y1 [expr [lindex $box 1]-2]
  1268.     set x2 [lindex $box 2]
  1269.     set y2 [lindex $box 3]
  1270.  
  1271.     set box_id [.groups.c create rectangle \
  1272.             $x1 $y1 $x2 $y2 -tags nodes ]
  1273.     set th_num($box_id) $a_num
  1274.     set bid($x,$y) $box_id
  1275.  
  1276. #   the width flags if selected or not
  1277.     if {$selected == 1} {
  1278.     .groups.c itemconfigure $box_id -width 2
  1279.     }
  1280.  
  1281.     if {$a_num >= 0} {
  1282.     .groups.c bind $n_id <Button-1>  "thread_button $box_id"
  1283.     }
  1284.  
  1285.     set xp [expr $x-1]
  1286.     set yp $y
  1287.     set ymid [expr ($y2+$y1)/2]
  1288.     if {[info exists bid($xp,$yp)]} {
  1289.     set pbox [.groups.c bbox $bid($xp,$yp)]
  1290.     .groups.c create line $x1  $ymid \
  1291.          [lindex $pbox 2] $ymid \
  1292.         -tags nodes
  1293.     } else {
  1294.     while {$yp > 0} {
  1295.         incr yp -1
  1296.         if {[info exists bid($xp,$yp)]} {
  1297.         set pbox [.groups.c bbox $bid($xp,$yp)]
  1298.         set xmid [expr ([lindex $pbox 0]+[lindex $pbox 2])/2]
  1299.         .groups.c create line $x1  $ymid \
  1300.             $xmid $ymid $xmid [lindex $pbox 3] \
  1301.             -tags nodes
  1302.         break
  1303.         }
  1304.     }
  1305.     }
  1306. }
  1307.  
  1308. proc thread_clear {} {
  1309.     global nid bid nprev 
  1310.  
  1311.     .groups.c  delete nodes
  1312.     .groups.c xview moveto 0
  1313.     .groups.c yview moveto 0
  1314.     catch {
  1315.     unset nid
  1316.     unset bid
  1317.     unset th_num
  1318.         unset nprev
  1319.         .groups.c delete area
  1320.     }
  1321. }
  1322.  
  1323. proc thread_draw_init {x y on} {
  1324.     global areaX1 areaY1  areaX2 areaY2 thread_on
  1325.     set thread_on $on
  1326.     set areaX1 [.groups.c canvasx $x]
  1327.     set areaY1 [.groups.c canvasy $y]
  1328.     set areaX2 $areaX1
  1329.     set areaY2 $areaY1
  1330.     .groups.c delete area
  1331. }
  1332.     
  1333. proc thread_draw {x y} {
  1334.     global areaX1 areaY1 areaX2 areaY2 thread_on
  1335.  
  1336.     if {$thread_on == 1} {
  1337.     set col "green"
  1338.     } else {
  1339.     set col "red"
  1340.     }
  1341.  
  1342.     set x [.groups.c canvasx $x]
  1343.     set y [.groups.c canvasy $y]
  1344.     if {($areaX1 != $x) && ($areaY1 != $y)} {
  1345.     .groups.c delete area
  1346.     .groups.c addtag area withtag [.groups.c create rect $areaX1 $areaY1 $x $y \
  1347.         -outline $col]
  1348.     set areaX2 $x
  1349.     set areaY2 $y
  1350.     }
  1351. }
  1352.  
  1353. proc thread_draw_in {} {
  1354.     global areaX1 areaY1 areaX2 areaY2 thread_on token
  1355.     set area [.groups.c find withtag area]
  1356.  
  1357.     foreach i [.groups.c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
  1358.     if {[.groups.c type $i] == "rectangle"} {
  1359.         thread_set $i $thread_on
  1360.     }
  1361.     }
  1362.     .groups.c delete area
  1363.     put_funct $token(K_READ_GROUP_UPDATE) "m"
  1364. }
  1365.  
  1366. proc thread_handle_Make {w} {
  1367.     global color_bd
  1368.  
  1369.     frame $w-handle -height 12 -width 12 -relief raised -borderwidth 2 \
  1370.     -cursor double_arrow -background $color_bd
  1371.     place $w-handle -relx 0.85 -y -6 -in $w
  1372.  
  1373.     bind $w-handle <Button-1> "thread_drag $w 0"
  1374.     bind $w-handle <B1-Motion> "thread_drag $w %y"
  1375.     bind $w-handle <ButtonRelease-1> "thread_drag_resize $w %y"
  1376.     frame $w-bar -width 800 -height 3 -bg red
  1377.     balloonHelp_traverse $w-handle
  1378. }
  1379.  
  1380. proc thread_drag {w y} {
  1381.     place $w-bar -y [top_y  $w $y] -x [top_x  $w 0] -anchor w
  1382. }
  1383.     
  1384. proc thread_drag_resize {w y} {
  1385.     global Config
  1386.  
  1387.     set curr [top_y  $w $y]
  1388.     set menu_top [top_y .groups.c 0]
  1389.     set new_size [expr $curr-$menu_top-[winfo height .groups.thr.x]]
  1390.     .groups.c configure -height $new_size
  1391.     set Config(thread_height) $new_size
  1392.     place  forget $w-bar
  1393. }
  1394.